home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
t3_1
/
risc_src.lha
/
risc_sources
/
sys
/
unix_mipsco.t
< prev
next >
Wrap
Text File
|
1990-10-15
|
6KB
|
162 lines
(herald bsd4_2 (env tsys))
(define file-mode/in #o0)
(define file-mode/out #o3001)
(define file-mode/append #o1011)
(define-constant number-of-signals 27) ;4.2
(define FIONREAD (make-bytev 4))
(set (bref-16-u fionread 0) #x4004)
(set (bref-16-u fionread 2) #x667f)
;;; handler-types (Htype): A = asynchronous, E = exception, D = default,
;;; I = ignore
;;; (sig# handler-type handler description)
(define *signals*
'(;( 1 E non-continuable "hangup")
; ( 2 A sigint-handler "interrupt")
; ( 3 A siquit-handler "quit")
( 4 E non-continuable "illegal instruction")
( 5 E non-continuable "trace/BPT trap")
( 6 E non-continuable "IOT instruction")
( 7 E non-continuable "EMT instruction")
( 8 E non-continuable "floating point exception")
; ( 9 D default "kill")
(10 E non-continuable "memory protection violation")
(11 E non-continuable "reference to non-existent memory")
(12 E non-continuable "bad argument to a system call")
(13 E non-continuable "broken pipe")
; (14 D default "alarm clock")
; (15 A sigterm-handler "software termination signal")
; (16 D default "urgent condition on socket")
; (17 D default "stop")
; (18 D default "stop signal generated from keyboard")
; (19 D default "continue after stop")
; (20 D default "child status has changed")
; (21 D default "background read attempted")
; (22 D default "background write attempted")
; (23 D default "i/o is possible")
(24 E non-continuable "cpu time limit exceeded")
(25 E non-continuable "file size limit exceeded")
; (26 D default "virtual time alarm")
; (27 D default "profiling timer alarm")
))
(define-constant %%SIGINT 2)
(define-constant %%SIGQUIT 3)
(define-constant %%SIGTERM 15)
(define-constant %%SIGSTOP 17)
(define-foreign r-nlistone
("nlistone" (in rep/string filename)
(in rep/string functionName))
rep/integer)
(define-integrable (t-nlistone file function)
(r-nlistone (string->asciz! (copy-string file))
(string->asciz! (copy-string function))))
;;; loader for foreign code under Unix ... in particular, C
;;; by Dorab Patel <dorab@neptune.cs.ucla.edu>
;;; Original: Feb 29, 1984
;;; Modified for t2.8: May 22, 1984 dorab@neptune.cs.ucla.edu
;;; Modified for t3: Dec 24, 1986 dorab@neptune.cs.ucla.edu
(define (make-foreign-procedure sym)
(let ((xeno (make-foreign sym))
(addr (t-nlistone (check-arg file-exists?
(reloc-file)
make-foreign-procedure)
(symbol->string sym))))
(cond ((fxn= addr 0)
(set (mref-integer xeno 4) addr)
xeno)
(else
(error "foreign procedure \"~a\" does not exist in file \"~a\""
(symbol->string sym)
(reloc-file))))))
;;; searchpath is a general utility function that takes a colon-separated
;;; path list and a filename, and finds the first file that exists in that
;;; directory list.
;;; maybe it should be elsewhere ?
;;; *********************************************************************
(define (searchpath path file)
(labels (
;; convert a colon-separated path into a list.
;; empty fields map to the current directory "."
;; **********************
((splitpath path)
(iterate
loop
((xpath path) (rv '())) ; initialization
(if (string-empty? xpath) ; if end of loop with colon
(reverse! (cons "." rv)) ; return with .
(let ((index (string-posq #\: xpath)))
(if index ; if a colon exists
(if (fx= index 0)
(loop (chdr xpath) (cons "." rv))
(loop (nthchdr xpath (fx+ index 1))
(cons (substring xpath 0 index)
rv)))
(reverse! (cons xpath rv)))))))) ; return from loop
;; start of searchpath
;; *******************
(if (and (char= (char file) #\slash) ; if name starts with /
(file-exists? (->filename file))) ; and it exists
file ; return it
(iterate loop ((xpath (splitpath path)))
(cond ((null? xpath) '#f) ; not found
(else (let ((xfile ; form full path name
(string-append (car xpath)
"/"
file)))
(if (file-exists? (->filename xfile))
xfile
(loop (cdr xpath))))))))))
;;; reloc-file contains the full path name of the file containing
;;; all the namelist information for the currently running Tau process.
;;; it is used by make-foreign-procedure and load-unix
;;; (reloc-file) returns the pathname
;;; (set (reloc-file) val) is used to set the name of the Tau binary to "val"
;;; (insert reloc-file v) is used to change the value of reloc-file to "v"
;;; (delete reloc-file nil) is used to delete the current reloc-file
;;; **********************************************************************
(define reloc-file
(let ((orig "/usr/local/t") ; default
(x "/usr/local/t"))
(object (lambda () x)
((insert self v)
(set x (enforce string? v)))
((delete self v) ; need two args -- hack!
(ignore v)
(or (string-equal? x orig) ; if not orig
(not (file-exists? x)) ; and it exists
(file-delete x))) ; then delete it
((setter reloc-file)
(lambda (val)
(set orig (enforce string? val)))))))
(define (initialize-local-system)
(cond ((searchpath (unix-getenv (copy-string "PATH"))
(car (command-line)))
=> (lambda (tau)
(set (reloc-file) tau) ; set orig value of reloc-file
(insert reloc-file tau) ; set current value
(insert exit-agenda ; to remove reloc files on exit
(lambda () (delete reloc-file nil)))))
(else (format (error-output)
"Could not find full path name for ~a~%"
(car (command-line))))))
(define (load-foreign file . rest) nil)